home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / ham.zip / OPTICS.PAS < prev    next >
Pascal/Delphi Source File  |  1985-08-31  |  4KB  |  160 lines
  1. Program Optics;
  2. {       By Bob Westwater             }
  3. {       6/2/85  Version 1.0          }
  4. {                                    }
  5. {   This program computes various    }
  6. {   parameters of a reflecting tele- }
  7. {   scope. It is adapted from a basic}
  8. {   program that was published by    }
  9. {   Byte magazine in March 1983 on   }
  10. {   page 450.                        }
  11. {        This version is for Turbo   }
  12. {   Pascal.      Enjoy---   - Bob -  }
  13.  
  14. Var
  15.   K,A,FD,SP,
  16.   FR,FA,AS,
  17.   SS,Step      : Real;
  18.   X            : Integer;
  19.   FL,FO,EF,
  20.   PO,PA,RD,
  21.   ER,MA,DL,
  22.   SC,CO,KN   : Real;
  23.   Astring    : Char;
  24.   Flag       : Boolean;
  25.   Response   : Char;
  26.  
  27. Const
  28.   PI = 3.14159;
  29.   Q = 180;
  30.   JJ = 250;
  31.  
  32. Procedure Setup;
  33.   Begin
  34.      KN := 0.3;
  35.      K:=(Q/PI)*3600;
  36.      ClrScr;
  37.      Writeln( 'This Telescope program computes');
  38.      Writeln( 'various parameters for a reflecting');
  39.      Writeln( 'telescope.');
  40.   end; {setup}
  41.  
  42. Procedure EyePiece( Astring :Char; KN :Real);
  43.     Begin
  44.          Case UpCase(Astring) of
  45.            'P' : KN := 0.75;
  46.            'O' : KN := 0.80;
  47.            'S' : KN := 0.80;
  48.            'E' : KN := 0.35;
  49.          end  {case}
  50.     end; {EyePiece}
  51.  
  52. Procedure Calc;
  53.    Begin
  54.       PO := FL/EF;
  55.       PA := PO;
  56.       RD := A/PO;
  57.       ER :=(FL*EF*KN)/(FL-EF);
  58.       MA := 9+(5*(LN(A)/LN(10)));
  59.       DL := 4.56/A;
  60.       SC := 8120.66/FL;
  61.    end;
  62.  
  63. Procedure GetData;
  64.   Begin
  65.     Write('Enter Aperture ');
  66.     Readln(A);
  67.     Write('Enter mirror F.L. ');
  68.     Readln(FL);
  69.     FO :=FL/A;
  70.     Write('Enter eyepiece F.L. ');
  71.     Readln(EF);
  72.     Write('Enter eyepiece type (P,O,S,E) ');
  73.     Readln(AString);
  74.     EyePiece(AString,KN);
  75.   end;
  76.  
  77. Procedure WaitForReturn;
  78.    Begin
  79.         Writeln('Press <RETURN> key to continue');
  80.         Readln;
  81.    end;
  82.  
  83. Procedure PrintSpecs;
  84.    Begin
  85.      ClrScr;
  86.      Writeln('Aperture =',A:6:2);
  87.      Writeln('Mirror F.L. =',FL:3:1);
  88.      Writeln('Effective F-stop = f/',FO:2:1);
  89.      Writeln('Eyepiece F.L. =',EF:1:3);
  90.      Writeln('Telescope Power =',PA:4:0);
  91.      Writeln('Eye Relief =',ER:1:5);
  92.      Writeln('Ramsden Disk =',RD:1:4);
  93.      Writeln('Mag. Limit =',MA:2:1);
  94.      Writeln('Dawes Limit =',DL:2:4,'"');
  95.      Writeln('P.F. Scale =',SC:1:3);
  96.      Writeln;
  97.    end;
  98.  
  99. Procedure Coma;
  100.   Begin
  101.      Write('Enter the field Diameter. ');
  102.      Readln(FD);
  103.      FR := FD/2;
  104.      Write('Enter step size ');
  105.      Readln(Step);
  106.      SS := 0;
  107.      ClrScr;
  108.      Writeln('   Angle     Coma       Astig');
  109.        While SS < FR do
  110.          Begin
  111.            FA := SS*(PI/Q);
  112.            CO := (FA/(16*(FO*FO)))*K;
  113.            AS :=((FA*FA)/(2*FO))*K;
  114.            Writeln('  ',SS:5:2,'      ',CO:5:5,'    ',AS:5:5);
  115.            SS := SS + Step;
  116.          end
  117.   end;
  118.  
  119. Procedure Radius;
  120.    Begin
  121.       ClrScr;
  122.       Writeln('  Radius    Coma    Astig');
  123.         While SS < 18 do
  124.           Begin
  125.             FA := (SS*SC)/K;
  126.             CO := (FA/(16*(FO*FO)))*K;
  127.             CO := CO/SC;
  128.             AS := ((FA*FA)/(2*FO))*K;
  129.             AS := AS/SC;
  130.             Writeln('  ',SS:5:2,'   ',CO:5:5,'   ',AS:5:5);
  131.             SS := SS + 2;
  132.           end
  133.    end;
  134.  
  135. begin
  136.   Flag := True;
  137.   While Flag = True do
  138.     Begin
  139.         setup;
  140.         getdata;
  141.         calc;
  142.         printspecs;
  143.         WaitForReturn;
  144.         Coma;
  145.         SP :=(0.0078/(FO*FO*FO))*K;
  146.         Writeln('AX.  SP.  AB. =',SP:5:5);
  147.         WaitForReturn;
  148.         Radius;
  149.         SP := SP/SC;
  150.         Writeln('AX. SP. AB. =',SP:5:5);
  151.         WaitForReturn;
  152.         Writeln('Want to do it again?');
  153.         readln(Response);
  154.           if UpCase(Response) = 'Y' then
  155.           Flag := True
  156.           else
  157.           Flag := False;
  158.      end {while}
  159. end. {main}if UpCase(Response) = 'Y' then
  160.